home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / twars.arc / TEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-28  |  41KB  |  1,484 lines
  1. program tedit;
  2.  
  3. type
  4.   str=string[160];
  5.   string1=string[66];
  6.  
  7. const
  8.   currentfile='tradewar\TWDATA.DAT';
  9.   item:array[1..3] of str=('Ore.......','Organics..','Equipment.');
  10.   b:array[1..3] of integer=(10,20,35);
  11.  
  12. type
  13.   users=record
  14.     name                   :string[41];
  15.     realname               :string[41];
  16.     fb,fc,fd,fe,ff,fg      :integer;
  17.     fh,fi,fj,fk,fl,fr,fp   :integer;
  18.     fm,fo,fq,ft,fv         :integer;
  19.     trophypts              :real;
  20.   end;
  21.  
  22.   small_message_record=record
  23.      message:str;
  24.      destin:integer;
  25.   end;
  26.  
  27.  
  28. var
  29.     smallmsg                                   :file of small_message_record;
  30.     pnn                                        :string[41];
  31.     year,a,month,day,go,playernumber,
  32.     pd,s2,st,g2,prr                            :integer;
  33.     ay,tt,lp,ls,lt1,ll1                        :integer;
  34.     userf                                      :file of users;
  35.     userr,usert                                :users;
  36.     e                                          :array[1..6] of integer;
  37.     m1,n,pub,c1                                :array[0..3] of real;
  38.     sectors                                    :array[0..200,0..1] of integer;
  39.     srr                                        :array[0..3,0..1] of real;
  40.     g                                          :array[0..9,0..1]   of integer;
  41.     ended,done                                 :boolean;
  42.     aim,thisline                               :str;
  43.     msger                                      :text;
  44.  
  45.  
  46.  
  47. function addblank(b:str;l:integer): str;
  48. begin
  49.   while length(b)<l do b:=' '+b;
  50.   addblank:=b;
  51. end;
  52.  
  53. function tch(i:string1):string1;
  54. begin
  55.   if length(i)>2 then i:=copy(i,length(i)-1,2)
  56.   else
  57.     if length(i)=1 then i:='0'+i;
  58.   tch:=i;
  59. end;
  60.  
  61. function value(i:str):integer;
  62. var n,n1:integer;
  63. begin
  64.   val(i,n,n1);
  65.   if n1<>0 then begin
  66.     i:=copy(i,1,n1-1);
  67.     val(i,n,n1)
  68.   end;
  69.   value:=n;
  70.   if i='' then value:=0;
  71. end;
  72.  
  73. function time:string1;
  74. var reg:record
  75.           ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
  76.         end;
  77.     h,m,s:string[4];
  78. begin
  79.   reg.ax:=$2c00;
  80.   intr($21,reg);
  81.   str(reg.cx shr 8,h);
  82.   str(reg.cx mod 256,m);
  83.   str(reg.dx shr 8,s);
  84.   time:=tch(h)+':'+tch(m)+':'+tch(s);
  85. end;
  86.  
  87. procedure readch(var answer:str);
  88. var
  89.     i : integer;
  90. begin
  91.     readln(answer);
  92.     for i := 1 to length(answer) do
  93.       answer[i] := upcase(answer[i]);
  94. end;
  95.  
  96. function date:str;
  97. var reg:record
  98.           ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
  99.         end;
  100.     m,d,y:string[4];
  101. begin
  102.   reg.ax:=$2a00;
  103.   msdos(reg);
  104.   str(reg.cx,y);
  105.   str(reg.dx mod 256,d);
  106.   str(reg.dx shr 8,m);
  107.   date:=tch(m)+'/'+tch(d)+'/'+tch(y);
  108. end;
  109.  
  110.  
  111.  
  112. function cstr(i:integer):str;
  113. var c:str;
  114. begin
  115.   str(i,c);
  116.   cstr:=c;
  117. end;
  118.  
  119. function mln(i:str; l:integer):str;
  120. begin
  121.   while length(i)<l do i:=i+' ';
  122.   mln:=i;
  123. end;
  124.  
  125. function cstrr(rl:real; base:integer):str;
  126. var c1,c2,c3:integer;
  127.     i:str;
  128.     r1,r2:real;
  129. begin
  130.   i:='';
  131.   if rl=0.0 then cstrr:='0'
  132.   else begin
  133.     if rl<0.0 then begin
  134.       i:='-';
  135.       rl:=-rl;
  136.     end;
  137.     r1:=ln(rl)/ln(1.0*base);
  138.     r2:=exp(ln(1.0*base)*(trunc(r1)));
  139.     while (r2>0.999) do begin
  140.       c1:=trunc(rl/r2);
  141.       i:=i+copy('0123456789ABCDEF',c1+1,1);
  142.       rl:=rl-c1*r2;
  143.       r2:=r2/(1.0*base);
  144.     end;
  145.     cstrr:=i;
  146.   end;
  147. end;
  148.  
  149.  
  150. function mn(i,l:integer):str;
  151. begin
  152.   mn:=mln(cstr(i),l);
  153. end;
  154.  
  155. function oks(n:integer):string1;
  156. begin
  157.   if n=1 then oks:='' else oks:='s';
  158. end;
  159.  
  160.  
  161. function sgn(i:integer): integer;
  162. begin
  163.   if i>0
  164.     then
  165.       sgn:=1
  166.     else
  167.       if i<0
  168.         then
  169.           sgn:=-1
  170.         else
  171.           sgn:=0;
  172. end;
  173.  
  174. procedure ynq(i:str);
  175. begin
  176.   textcolor(2);
  177.   write(i);
  178. end;
  179.  
  180.  
  181. function inkey:char;
  182. var c:char;
  183. begin
  184.   c:=chr(0);
  185.   inkey:=chr(0);
  186.   if keypressed then begin
  187.     read(kbd,c);
  188.     if c=chr(27) then
  189.       if keypressed then begin
  190.         read(kbd,c);
  191.         if c=#68 then c:=#1
  192.         else c:=#0;
  193.       end;
  194.     inkey:=c;
  195.   end;
  196. end;
  197.  
  198.  
  199.  
  200. function yn:boolean;
  201. var c:char;
  202. begin
  203.     textcolor(3);
  204.     repeat
  205.       c:=inkey;
  206.       c:=upcase(c);
  207.     until (c='Y') or (c='N') or (c=chr(13));
  208.     if c='Y' then begin
  209.       writeln('Yes'); yn:=true;
  210.     end else begin
  211.       writeln('No'); yn:=false;
  212.     end;
  213. end;
  214.  
  215.  
  216. procedure readin(i:integer;var user:users);
  217. begin
  218.   seek(userf,i);
  219.   read(userf,user);
  220. end;
  221.  
  222. procedure writeout(i:integer;user:users);
  223. begin
  224.   seek(userf,i);
  225.   write(userf,user);
  226. end;
  227.  
  228.  
  229. procedure getint(var i:integer);
  230. var s:string[5];
  231. begin
  232.   readln(s);  {input(s,5);}
  233.   if s<>'' then i:=value(s);
  234. end;
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241. procedure getdate;
  242. var a,code:integer;
  243.     datea:str;
  244.  
  245.  
  246. begin
  247.   datea:=date;
  248.   val(copy(datea,7,4),year,code);
  249.   val(copy(datea,1,2),month,code);
  250.   val(copy(datea,4,2),day,code);
  251.   if (year/4=int(year/4)) and (month>2) then day:=day+1;
  252.   case month of
  253.   2:day:=day+31;
  254.   3:day:=day+59;
  255.   4:day:=day+90;
  256.   5:day:=day+120;
  257.   6:day:=day+151;
  258.   7:day:=day+181;
  259.   8:day:=day+212;
  260.   9:day:=day+243;
  261.   10:day:=day+273;
  262.   11:day:=day+304;
  263.   12:day:=day+334;
  264.   end; {case}
  265.   if year<ay then year:=year+100;
  266.   if year<>ay then
  267.     for a:=ay to year-1 do begin
  268.       day:=day+365;
  269.       if a/4=int(a/4) then day:=day+1;
  270.     end;
  271. end;
  272.  
  273. procedure removeship(p:integer);
  274. var r,b:integer;
  275.     done:boolean;
  276. begin
  277.   r:=usert.ff;
  278.   if a<>0 then begin
  279.     readin(lp+r,userr);
  280.     a:=userr.fi;
  281.     if a=p then begin
  282.       readin(a,userr);
  283.       b:=userr.fo;
  284.       readin(lp+r,userr);
  285.       userr.fi:=b;
  286.       writeout(lp+r,userr);
  287.     end else begin
  288.       done:=false;
  289.       readin(a,userr);
  290.       repeat
  291.         if userr.fo=p then begin
  292.           b:=a;
  293.           done:=true;
  294.         end;
  295.         a:=userr.fo;
  296.         readin(a,userr);
  297.       until done;
  298.       a:=userr.fo;
  299.       readin(b,userr);
  300.       userr.fo:=a;
  301.       writeout(b,userr);
  302.     end;
  303.   end;
  304. end;
  305.  
  306. procedure rsm;
  307. var sr:small_message_record;
  308.     i:integer;
  309. begin
  310.   {$I-} reset(smallmsg); {$I+}
  311.   if ioresult=0 then begin
  312.     i:=0;
  313.     while (i<=filesize(smallmsg)-1) do begin
  314.       seek(smallmsg,i);
  315.       read(smallmsg,sr);
  316.       if sr.destin=playernumber then begin
  317.         writeln(sr.message);
  318.         sr.destin:=-1;
  319.         seek(smallmsg,i); write(smallmsg,sr);
  320.       end;
  321.       i:=i+1;
  322.     end;
  323.     close(smallmsg);
  324.   end else writeln('Error opening Trade Wars small message file.');
  325. end;
  326.  
  327.  
  328. procedure delete(p: integer);
  329. var l:integer;
  330. begin
  331.   writeln;
  332.   writeln('Deleting '+usert.name+'...');
  333.   removeship(p);
  334.   usert.realname:='Unused Player Record';
  335.   usert.fm:=0;
  336.   for l:=lp+1 to ls do begin
  337.     readin(l,userr);
  338.     if userr.fm=p then begin
  339.       userr.fm:=0;
  340.       userr.fl:=0;
  341.       writeout(l,userr);
  342.     end;
  343.     if userr.fb=p then begin
  344.       userr.fc:=-98;
  345.       writeout(l,userr);
  346.     end;
  347.   end;
  348.   playernumber:=p;
  349.   rsm;
  350. end;
  351.  
  352. procedure addship(p:integer);
  353. var r,b:integer;
  354.     done:boolean;
  355. begin
  356.   r:=usert.ff;
  357.   if r<>0 then begin
  358.     readin(lp+r,userr);
  359.     b:=userr.fi;
  360.     userr.fi:=p;
  361.     writeout(lp+r,userr);
  362.     usert.fo:=b;
  363.   end;
  364. end;
  365.  
  366. procedure upport(p2:integer);
  367. var c,l,code,mn:integer;
  368.     temp,dim:real;
  369. begin
  370.   readin(p2,usert);
  371.   n[1]:=usert.fd+usert.fr/10000;
  372.   n[2]:=usert.fe+usert.fo/10000;
  373.   n[3]:=usert.ff+usert.fp/10000;
  374.   pub[1]:=usert.fg;
  375.   pub[2]:=usert.fh;
  376.   pub[3]:=usert.fi;
  377.   c1[1]:=usert.fj;
  378.   c1[2]:=usert.fk;
  379.   c1[3]:=usert.fl;
  380.   getdate;
  381.   c:=day;
  382.   mn:=value(copy(time,1,2))*60+value(copy(time,4,2));
  383.   dim:=day-usert.fc+(mn-usert.fq)/1440;
  384.   if dim>=0 then begin
  385.     if dim>10 then dim:=10.0;
  386.     for l:=1 to 3 do begin
  387.       n[l]:=n[l]+pub[l]*dim;
  388.       if n[l]>pub[l]*10 then n[l]:=pub[l]*10;
  389.     end;
  390.   end;
  391.   for l:=1 to 3 do m1[l]:=int(b[l]*(1-c1[l]*n[l]/pub[l]/1000)+0.5);
  392.   readin(p2,usert);
  393.   usert.fc:=c;
  394.   usert.fd:=trunc(n[1]);
  395.   usert.fe:=trunc(n[2]);
  396.   usert.ff:=trunc(n[3]);
  397.   for l:=1 to 3 do begin
  398.     srr[l,0]:=int((n[l]-int(n[l]))*10000+0.5);
  399.     n[l]:=int(n[l]);
  400.   end;
  401.   usert.fr:=trunc(srr[1,0]);
  402.   usert.fo:=trunc(srr[2,0]);
  403.   usert.fp:=trunc(srr[3,0]);
  404.   usert.fq:=mn;
  405.   writeout(p2,usert);
  406. end;
  407.  
  408. procedure port;
  409. var c,l,portnum,i:integer;
  410.     st:str;
  411.     x:str;
  412.     dim:real;
  413.     done:boolean;
  414.  
  415.   function buysell(t:real):string1;
  416.   begin
  417.     if t>=0.0 then buysell:='  <-- Selling'
  418.     else buysell:='  <-- Buying';
  419.   end;
  420.  
  421. begin
  422.   done:=false;
  423.   writeln('Edit which port: "####" (sector number) or "P###" (port number)');
  424.   write('Port ID: (<CR>=Abort): ');
  425.   readch(st);
  426.   writeln;
  427.   if st='' then exit;
  428.   if (st[1]='P') or (st[1]='p') then portnum:=value(copy(st,2,4))
  429.   else begin
  430.     i:=value(st);
  431.     if (i<2) or (i>ls-lp) then begin
  432.       writeln('Illegal sector number.');
  433.       exit;
  434.     end;
  435.     readin(i+lp,usert);
  436.     portnum:=usert.fh;
  437.     if portnum=0 then begin
  438.       writeln('No port in that sector.');
  439.       exit;
  440.     end;
  441.   end;
  442.  
  443.   writeln('portnum is ',portnum);
  444.   portnum:=portnum+ls;
  445.   if (portnum<ls+1) or (portnum>ls+400) then begin
  446.     writeln('Illegal port number:',portnum);
  447.     exit;
  448.   end;
  449.   upport(portnum);
  450.   repeat
  451.     writeln('Port number: '+cstr(portnum-ls));
  452.     writeln('<A> Name: '+usert.name);
  453.     writeln('<B> Class: '+cstr(usert.fb));
  454.     writeln('<C> Ore: '+mn(usert.fd,5)+' (Price='+mn(trunc(m1[1]),3)+')'+
  455.           buysell(usert.fj));
  456.     writeln('<D> Org: '+mn(usert.fe,5)+' (Price='+mn(trunc(m1[2]),3)+')'+
  457.           buysell(usert.fk));
  458.     writeln('<E> Equ: '+mn(usert.ff,5)+' (Price='+mn(trunc(m1[3]),3)+')'+
  459.           buysell(usert.fl));
  460.     writeln('Productivity (units per day)');
  461.     writeln('   <F> Ore: '+cstr(usert.fg)+'   <G> Org: '+cstr(usert.fh)+
  462.           '   <H> Equ: '+cstr(usert.fi));
  463.     writeln('Maximum change in cost (percent)');
  464.     writeln('   <I> Ore: '+cstr(usert.fj)+'   <J> Org: '+cstr(usert.fk)+
  465.           '   <K> Equ: '+cstr(usert.fl));
  466.     writeln;
  467.     writeln('WARNING: I do not recommended changing values <F> though <K>!');
  468.     writeln;
  469.     write('Port editor: (Q=Quit): ');
  470.     readch(x);
  471.     writeln;
  472.     case x of
  473.     'Q',#13:done:=true;
  474.     'A':begin
  475.           write('New name: ');
  476.           {input(st,41);}
  477.           readln(st);
  478.           if st<>'' then usert.name:=st;
  479.           USERT.FM := LENGTH(ST);
  480.         end;
  481.     'B':begin
  482.           write('New class: ');
  483.           getint(usert.fb);
  484.         end;
  485.     'C':begin
  486.           write('New amount of ore: ');
  487.           getint(usert.fd);
  488.           if usert.fd>usert.fg*10.0 then
  489.             writeln('WARNING: Normal range is 0 to '+cstr(usert.fg*10)+'.');
  490.         end;
  491.     'D':begin
  492.           write('New amount of organics: ');
  493.           getint(usert.fe);
  494.           if usert.fe>usert.fh*10.0 then
  495.             writeln('WARNING: Normal range is 0 to '+cstr(usert.fh*10)+'.');
  496.          end;
  497.     'E':begin
  498.           write('New amount of equipment: ');
  499.           getint(usert.ff);
  500.           if usert.ff>usert.fi*10.0 then
  501.             writeln('WARNING: Normal range is 0 to '+cstr(usert.fi*10)+'.');
  502.         end;
  503.     'F':begin
  504.           write('Productivity (units/day) for ore: ');
  505.           getint(usert.fg);
  506.           if usert.fg>3000 then writeln('WARNING: Safe range in 0 to 3000.');
  507.         end;
  508.     'G':begin
  509.           write('Productivity (units/day) for organics: ');
  510.           getint(usert.fh);
  511.           if usert.fh>3000 then writeln('WARNING: Safe range in 0 to 3000.');
  512.         end;
  513.     'H':begin
  514.           write('Productivity (units/day) for equipment: ');
  515.           getint(usert.fi);
  516.           if usert.fi>3000 then writeln('WARNING: Safe range in 0 to 3000.');
  517.         end;
  518.     'I':begin
  519.           writeln('Max change in cost for ore (%): ');
  520.           getint(usert.fj);
  521.         end;
  522.     'J':begin
  523.           writeln('Max change in cost for organics (%): ');
  524.           getint(usert.fk);
  525.         end;
  526.     'K':begin
  527.           writeln('Max change in cost for equipment (%): ');
  528.           getint(usert.fl);
  529.         end;
  530.     end; {case}
  531.     writeout(portnum,usert);
  532.   until done;
  533. end;
  534.  
  535.  
  536. procedure init;
  537. var l:integer;
  538.     done:boolean;
  539. begin
  540.   writeln;
  541.   assign(msger,'tradewar\TWOPENG.DAT');
  542.   reset(msger);
  543.   append(msger);
  544.   assign(smallmsg,'tradewar\TWSMF.DAT');
  545.   ended:=false;
  546.   assign(userf,'tradewar\TWDATA.DAT');
  547.   reset(userf);
  548.   readin(1,userr);
  549.   with userr do begin
  550.     ay:=fc;
  551.     tt:=fd;
  552.     lp:=fe;
  553.     ls:=ff;
  554.     lt1:=fg;
  555.     ll1:=fo;
  556.   end;
  557.   getdate;
  558.   pd:=day;
  559. end;
  560.  
  561. procedure userlist;
  562. var r:integer;
  563.     abort,next:boolean;
  564. begin
  565.   writeln; abort:=false;
  566.   writeln('Player status as of: '+date+' '+time);
  567.   writeln;
  568.   textcolor(10);
  569.   writeln('ID# User Name                         Sec TL  Fght CH  Ore Org Equ Crdts DP');
  570.   textcolor(15);
  571.   writeln('--- --------------------------------- --- --- ---- --- --- --- --- ----- -----');
  572.   textcolor(7);
  573.   r:=2;
  574.   abort:=false;
  575.   repeat
  576.     readin(r,usert);
  577.       writeln(addblank(cstr(r),3)+' '+mln(usert.name,33)+' '+
  578.             addblank(cstr(usert.ff),3)+' '+addblank(cstr(usert.fd),3)+' '+
  579.             addblank(cstr(usert.fg),4)+' '+addblank(cstr(usert.fh),3)+' '+
  580.             addblank(cstr(usert.fi),3)+' '+addblank(cstr(usert.fj),3)+' '+
  581.             addblank(cstr(usert.fk),3)+' '+addblank(cstr(usert.fl),5)+' '+
  582.             addblank(cstrr(usert.trophypts,10),5));
  583.     r:=r+1;
  584.   until abort or (r+1>lp);
  585. textcolor(2);
  586. end;
  587.  
  588. procedure getuser(var p:integer; a:str);
  589. var c:char;
  590. label option;
  591.  
  592. begin
  593.   p:=2;
  594.   if a='' then p:=0
  595.   else
  596.     if value(a)<>0 then p:=value(a)
  597.     else begin
  598.       repeat
  599.         readin(p,usert);
  600.         if usert.name=a then exit;
  601.         p:=p+1;
  602.       until p>lp;
  603.       p:=2;
  604.       repeat
  605.         readin(p,usert);
  606.         if pos(a,usert.name)<>0 then begin
  607.           writeln;
  608.           writeln('Incomplete match: '+usert.name+' (#'+cstr(p)+')');
  609.       option:
  610.           write('Option: (Y,N,Q,?): ');
  611.           read(c);
  612.           case c of
  613.           '?':begin
  614.                 writeln('(Y)es - This is the correct user');
  615.                 writeln('(N)o  - Look for next matching user');
  616.                 writeln('(Q)uit search'); writeln;
  617.                 goto option;
  618.               end;
  619.           'Y':exit;
  620.           'Q':p:=lp+1;
  621.           'N':p:=p+1;
  622.           end; {case}
  623.         end else p:=p+1;
  624.       until p>lp;
  625.       writeln('Unknown user.');
  626.     end;
  627. end;
  628.  
  629. procedure uedit;
  630. var i:str;
  631.     p,e:integer;
  632.     done2:boolean;
  633.  
  634.   procedure checkwarning;
  635.   begin
  636.     if usert.fi+usert.fj+usert.fk>usert.fh then
  637.       writeln('WARNING: Amount of cargo is greater than number of cargo holds.');
  638.   end;
  639.  
  640. begin
  641.   writeln;
  642.   write('Enter user number: ');
  643.   readln(i);  {input(i,41);}
  644.   getuser(playernumber,i);
  645.   if playernumber<>0 then
  646.     if (playernumber<2) or (playernumber>lp) then
  647.       writeln('Invalid user number.')
  648.     else begin
  649.       done2:=false;
  650.       readin(playernumber,usert);
  651.       while not done2 do begin
  652.         writeln;
  653.         write('<A> Name: ');
  654.         if usert.fm=0 then writeln('<Player record not used>')
  655.         else writeln(usert.name+' (#'+cstr(playernumber)+')');
  656.         write('<W> Weal Name : ');
  657.         writeln(usert.realname);
  658.         write('<B> Last day on: ');
  659.         getdate;
  660.         e:=usert.fb;
  661.         day:=day-e;
  662.         if day=0 then writeln('Today')
  663.         else
  664.           if day>0 then writeln(cstr(day)+' day'+oks(day)+' ago')
  665.           else writeln('Will be allowed on in '+cstr(-day)+' day'+oks(-day));
  666.         a:=usert.fc;
  667.         write('<C> Killed by: ');
  668.         if a=0 then writeln('<No one>')
  669.         else
  670.           if a=-99 then writeln('<To be initialized>')
  671.           else
  672.             if a=-98 then writeln('<A person who has been deleted>')
  673.             else
  674.               if a=-1 then writeln('<Cabel>')
  675.               else
  676.                 if (a<2) or (a>lp) then writeln('<Unknown value: '+cstr(a)+'>')
  677.                 else begin
  678.                   readin(a,userr);
  679.                   writeln(userr.name+' (#'+cstr(a)+')');
  680.                 end;
  681.         writeln('<D> Turns left: '+cstr(usert.fd));
  682.         writeln('<E> Location: Sector '+cstr(usert.ff));
  683.         writeln('<F> Fighters: '+cstr(usert.fg));
  684.         writeln('<G> Total cargo holds: '+cstr(usert.fh));
  685.         writeln('<H>    Ore: '+cstr(usert.fi));
  686.         writeln('<I>    Org: '+cstr(usert.fj));
  687.         writeln('<J>    Eqp: '+cstr(usert.fk));
  688.         writeln('<K> Credits: '+cstr(usert.fl));
  689.         writeln('<L> Last room in: '+cstr(usert.fq));
  690.         writeln('<T> Member of Team: '+cstr(usert.fr));
  691.         writeln('<M> Chain link pointer: '+cstr(usert.fo));
  692.         writeln('<!> Delete this user');
  693.         writeln('<Z> Initialize this user');
  694.         writeln;
  695.         write('User edit: (Q=Quit): ');
  696.         readch(i);
  697.         writeln;
  698.         a:=-1;
  699.         case i[1] of
  700.         'A':begin
  701.               write('New name: ');
  702.               {input(i,41);}
  703.               readln(i);
  704.               if i<>'' then begin
  705.                 usert.name:=i;
  706.                 if usert.fm<>0 then usert.fm:=LENGTH(I);
  707.               end;
  708.             end;
  709.         'W':begin
  710.               write('New Real name: ');
  711.               {input(i,41);}
  712.               readln(i);
  713.               if i<>'' then begin
  714.                 usert.realname:=i;
  715.               end;
  716.             end;
  717.         'B':begin
  718.               writeln('New last day on: ');
  719.               writeln('(1=yesterday, 0=today, -3=will not be allowed on for 3 days)');
  720.               write('Day: ');
  721.               a:=32000;
  722.               getint(a);
  723.               if a<>32000 then begin
  724.                 getdate;
  725.                 usert.fb:=day-a;
  726.               end;
  727.             end;
  728.         'C':begin
  729.               writeln('Who killed this user (by user number):');
  730.               writeln('(-99=to be initialized, -98=some who has been deleted, -1=cabel,');
  731.               writeln(' 0=still alive, greater then 2 for a specific user)');
  732.               write('Killed by: ');
  733.               a:=32000;
  734.               getint(a);
  735.               if a<>32000 then
  736.                 if (a=1) or (a<-1) or (a>lp) then writeln('Illegal value.')
  737.                 else usert.fc:=a;
  738.             end;
  739.         'D':begin
  740.               write('New number of turns left: ');
  741.               a:=32000;
  742.               getint(a);
  743.               if a<>32000 then usert.fd:=a;
  744.             end;
  745.         'E':begin
  746.               write('New location: ');
  747.               p:=-1;
  748.               getint(p);
  749.               if (p<1) or (p>ls-lp) then writeln('Illegal sector number.')
  750.               else begin
  751.                 writeln;
  752.                 writeln('WARNING: Answer "NO" to the following two questions unless youknow');
  753.                 writeln('         know exactly what is going on.');
  754.                 writeln;
  755.                 ynq('Skip removal of ship from sector chain link (Y/N) ? ');
  756.                 if not yn then removeship(playernumber);
  757.                 usert.ff:=p;
  758.                 writeln;
  759.                 ynq('Skip addition of ship to the sector chain (Y/N) ? ');
  760.                 if not yn then addship(playernumber);
  761.               end;
  762.             end;
  763.         'F':begin
  764.               write('New number of fighters: ');
  765.               getint(a);
  766.               if (a<0) or (a>9999) then writeln('Illegal value.')
  767.               else usert.fg:=a;
  768.             end;
  769.         'G':begin
  770.               write('New number of cargo holds: ');
  771.               getint(a);
  772.               if (a<1) or (a>150) then writeln('Illegal value.')
  773.               else begin
  774.                 usert.fh:=a;
  775.                 checkwarning;
  776.               end;
  777.             end;
  778.         'H':begin
  779.               write('New amount of ore: ');
  780.               getint(a);
  781.               if a<0 then writeln('Illegal value.')
  782.               else begin
  783.                 usert.fi:=a;
  784.                 checkwarning;
  785.               end;
  786.             end;
  787.         'I':begin
  788.               write('New amount of organics: ');
  789.               getint(a);
  790.               if a<0 then writeln('Illegal value.')
  791.               else begin
  792.                 usert.fj:=a;
  793.                 checkwarning;
  794.               end;
  795.             end;
  796.         'J':begin
  797.               write('New amount of equipment: ');
  798.               getint(a);
  799.               if a<0 then writeln('Illegal value.')
  800.               else begin
  801.                 usert.fk:=a;
  802.                 checkwarning;
  803.               end;
  804.             end;
  805.         'K':begin
  806.               write('New number of credits: ');
  807.               getint(a);
  808.               if a<0 then writeln('Illegal value.')
  809.               else usert.fl:=a;
  810.             end;
  811.         'L':begin
  812.               write('New last room in: ');
  813.               getint(a);
  814.               if (a<1) or (a>ls-lp) then writeln('Illegal sector number.')
  815.               else usert.fq:=a;
  816.             end;
  817.         'T':begin
  818.               write('New Team number: ');
  819.               getint(a);
  820.               if (a<0) or (a>50) then writeln('Illegal team number.')
  821.               else usert.fr:=a;
  822.             end;
  823.         'M':begin
  824.               writeln('WARNING: You better know what your doing!');
  825.               writeln;
  826.               write('New chain link pointer: ');
  827.               getint(a);
  828.               if (a<>0) and ((a<2) or (a>lp)) then
  829.                 writeln('Invalid user number.')
  830.               else usert.fo:=a;
  831.             end;
  832.         '!':begin
  833.               ynq('Delete ');
  834.               if usert.fm=0 then write('<Player record not used>')
  835.               else write(usert.name+' (#'+cstr(playernumber)+') (Y/N) ? ');
  836.               if yn then begin
  837.                 delete(playernumber);
  838.                 writeln;
  839.                 writeln('Player deleted.');
  840.               end;
  841.             end;
  842.         'Z':begin
  843.               writeln('Not currently implemented'); {
  844.               writeln('Note: Do NOT use this command unless you know what you are doing.');
  845.               writeln('      Backup the Trade Wars'' data files in any case.');
  846.               writeln;
  847.               ynq('Initialize ');
  848.               if usert.fm=0 then write('<Player record not used> (Y/N) ? ')
  849.               else write(usert.name+' (#'+cstr(playernumber)+') (Y/N) ? ');
  850.               if yn then begin
  851.                 writeln;
  852.                 ynq('Remove ship from sector chain link (Y/N) ? ');
  853.                 if yn then removeship(playernumber);
  854.                 readin(1,userr);
  855.                 with usert do begin
  856.                   fb:=pd;
  857.                   fc:=0;
  858.                   fd:=tt;
  859.                   ff:=1;
  860.                   fg:=userr.fh;
  861.                   fh:=userr.fj;
  862.                   fi:=0;
  863.                   fj:=0;
  864.                   fk:=0;
  865.                   fl:=userr.fi;
  866.                   fm:=1;
  867.                 end;
  868.                 addship(playernumber);
  869.                 writeln;
  870.                 writeln('Initialized.');
  871.               end;
  872.             }
  873.             end;
  874.         #13,'Q':done2:=true;
  875.         end; {case}
  876.       end; {while}
  877.       writeout(playernumber,usert);
  878.     end;
  879.     done:=true;
  880. end;
  881.  
  882. procedure gedit;
  883. var a:integer;
  884.     i:str;
  885.     c:str;
  886. begin
  887.   readin(1,usert);
  888.   writeln;
  889.   writeln('<A> Turns per day: '+cstr(usert.fd));
  890.   writeln('<B> Initial fighters: '+cstr(usert.fh));
  891.   writeln('<C> Initial credits: '+cstr(usert.fi));
  892.   writeln('<D> Initial cargo holds: '+cstr(usert.fj));
  893.   writeln('<E> Days until an inactive user is deleted: '+cstr(usert.fk));
  894.   write('<F> Last day maintenance run: ');
  895.   getdate;
  896.   a:=usert.fl;
  897.   if day=a then writeln('Today')
  898.   else
  899.     if day-1=a then writeln('Yesterday')
  900.     else
  901.       if a<day then writeln(cstr(day-a)+' days ago')
  902.       else writeln('Will not be ran for another '+cstr(a-day)+' day'+oks(a-day));
  903.   writeln('    Maximum number of players: '+cstr(lp-1));
  904.   writeln('    Number of sectors: '+cstr(ls-lp));
  905.   writeln('    Number of ports: '+cstr(lt1-ls));
  906.   writeln('<G> Cabel regeneration: '+cstr(usert.fr)+' fighters per day');
  907.   writeln;
  908.   write('General Editor: (Q=Quit): ');
  909.   readch(c);
  910.   a:=-1;
  911.   case c of
  912.   'Q',#13:done:=true;
  913.   'A':begin
  914.         write('New number of turns allowed per day: ');
  915.         getint(a);
  916.         if a<1 then writeln('Illegal value.') else usert.fd:=a;
  917.       end;
  918.   'B':begin
  919.         write('New initial number of fighters: ');
  920.         getint(a);
  921.         if (a<1) or (a>9999) then writeln('Illegal value.')
  922.         else usert.fh:=a;
  923.       end;
  924.   'C':begin
  925.         write('New initial number of credits: ');
  926.         getint(a);
  927.         if a<0 then writeln('Illegal value.') else usert.fi:=a;
  928.       end;
  929.   'D':begin
  930.         write('New initial number of cargo holds: ');
  931.         getint(a);
  932.         if (a<1) or (a>150) then writeln('Illegal value.')
  933.         else usert.fj:=a;
  934.       end;
  935.   'E':begin
  936.         write('New number of days until deleted: ');
  937.         getint(a);
  938.         if a<1 then writeln('Illegal value.') else usert.fk:=a;
  939.       end;
  940.   'F':begin
  941.         writeln('New last day when maintenance program was run:');
  942.         writeln('(0=Today, 1=Yesterday, -4=will not be run for another 4 days)');
  943.         write('Day: ');
  944.         a:=-32000;
  945.         getint(a);
  946.         if (a<-999) or (a>999) then writeln('Illegal value.')
  947.         else usert.fl:=day-a;
  948.       end;
  949.   'G':begin
  950.         write('New cabel regeneration per day (# fighters): ');
  951.         getint(a);
  952.         if a<0 then writeln('Illegal value.') else usert.fr:=a;
  953.       end;
  954.   end; {case}
  955.   writeout(1,usert);
  956. end;
  957.  
  958. procedure sector;
  959. var c:str;
  960.     t,y,u:integer;
  961.     st:str;
  962.  
  963.   procedure writeln_sect;
  964.   var a:integer;
  965.   begin
  966.     writeln('Sector: '+cstr(s2-lp));
  967.     writeln('  <Z> Nebulae : '+usert.name);
  968.     writeln('Warps lead to: ');
  969.     writeln('  <A> '+cstr(usert.fb));
  970.     writeln('  <B> '+cstr(usert.fc));
  971.     writeln('  <C> '+cstr(usert.fd));
  972.     writeln('  <D> '+cstr(usert.fe));
  973.     writeln('  <E> '+cstr(usert.ff));
  974.     writeln('  <F> '+cstr(usert.fg));
  975.     write('<G> Port in sector: ');
  976.     if usert.fh<>0 then begin
  977.       readin(usert.fh+ls,userr);
  978.       writeln(userr.name+' (#'+cstr(usert.fh)+')');
  979.     end else writeln('None');
  980.     write('<H> Fighters in sector: ');
  981.     if usert.fl=0 then writeln('None')
  982.     else begin
  983.       write(cstr(usert.fl));
  984.       if usert.fm<1 then writeln(' (Ferrengi)')
  985.       else
  986.         if usert.fm=0 then writeln(' (No one)')
  987.         else
  988.           if usert.fm>lp then writeln(' (Invalid player #'+cstr(usert.fm))
  989.           else begin
  990.             readin(usert.fm,userr);
  991.             writeln(' (belong to '+userr.name+' (#'+cstr(usert.fm)+'))');
  992.           end;
  993.     end;
  994.     writeln('<I> Starting chain link pointer: '+cstr(usert.fi));
  995.     write  ('<J> Planet in this sector: ');
  996.         if usert.fo<>0 then begin
  997.       readin(usert.fo+lt1,userr);
  998.       writeln(userr.name+' (#'+cstr(usert.fo)+')');
  999.     end else writeln('None');
  1000.     writeln('    People in sector: ');
  1001.     a:=usert.fi;
  1002.     if a=0 then writeln('      None')
  1003.     else begin
  1004.       repeat
  1005.         readin(a,userr);
  1006.         writeln('      '+userr.name+' with '+cstr(userr.fg)+' fighters');
  1007.         if a<>userr.fo then a:=userr.fo
  1008.         else begin
  1009.           writeln('      <Infinite loop error>');
  1010.           a:=0;
  1011.         end;
  1012.       until (a=0);
  1013.     end;
  1014.   end;
  1015.  
  1016. begin
  1017.   done:=true;
  1018.   write('Sector number (<CR>=Quit): ');
  1019.   t:=0;
  1020.   getint(t);
  1021.   if (t<1) or (t>ls-lp) then writeln('Illegal sector number.')
  1022.   else begin
  1023.     done:=false;
  1024.     s2:=t+lp;
  1025.     readin(s2,usert);
  1026.   end;
  1027.   while not done do begin
  1028.     writeln_sect;
  1029.     writeln;
  1030.     write('Sector Editor (Q=Quit): ');
  1031.     readch(c);
  1032.     if c[1] in ['A'..'G'] then write('Leads to what sector: ');
  1033.     y:=-1;
  1034.     case c[1] of
  1035.     'Q',#13:done:=true;
  1036.     'A':getint(usert.fb);
  1037.     'B':getint(usert.fc);
  1038.     'C':getint(usert.fd);
  1039.     'D':getint(usert.fe);
  1040.     'E':getint(usert.ff);
  1041.     'F':getint(usert.fg);
  1042.     'G':getint(usert.fh);
  1043.     'Z':begin
  1044.            write('Enter new Nebulae name: ');
  1045.            readln(st);
  1046.            if st<>'' then
  1047.               usert.name :=st;
  1048.            writeout(s2,usert);
  1049.         end;
  1050.     'H':begin
  1051.           write('New number of fighters: ');
  1052.           getint(y);
  1053.           if (y<0) or (y>9999) then writeln('Illegal value.')
  1054.           else begin
  1055.             if y=0 then usert.fm:=0
  1056.             else begin
  1057.               u:=-2;
  1058.               write('Who do they belong to (-1=Cabel,0=No one): ');
  1059.               getint(u);
  1060.               if (u<-1) or (u=1) or (u>lp) then writeln('Illegal player number.')
  1061.               else usert.fm:=u;
  1062.             end;
  1063.             usert.fl:=y;
  1064.           end;
  1065.         WRITEOUT(S2,USERT);
  1066.         end;
  1067.     'I':begin
  1068.           writeln('WARNING: You better know what your doing!');
  1069.           writeln;
  1070.           write('New player pointer: ');
  1071.           getint(y);
  1072.           USERT.FI:=0;
  1073.           usert.fm:=y;
  1074.           USERT.FL:=0;
  1075.           WRITEOUT(S2,USERT);
  1076.        end;
  1077.     'J':begin
  1078.           writeln('WARNING: You better know what your doing!');
  1079.           writeln;
  1080.           write('New planet pointer: ');
  1081.           getint(y);
  1082.           if (y<>0) and ((y<1) or (y>149)) then
  1083.             writeln('Invalid planet number.')
  1084.           else usert.fo:=y;
  1085.           WRITEOUT(S2,USERT);
  1086.         end;
  1087.  
  1088.     end; {case}
  1089.   end; {while}
  1090.   writeout(s2,usert);
  1091. end;
  1092.  
  1093. procedure cabel;
  1094. var r,b,go,l,m:integer;
  1095.     im:str;
  1096.  
  1097. procedure cabel_writeln;
  1098. begin
  1099.   for l:=1 to 9 do begin
  1100.     readin(l+lp,userr);
  1101.     g[l,0]:=userr.ft;
  1102.     g[l,1]:=0;
  1103.   end;
  1104.   for l:=1 to 8 do
  1105.     for m:=l+1 to 9 do
  1106.       if g[l,0]=g[m,0] then g[m,0]:=0;
  1107.   go:=0;
  1108.   for l:=1 to 9 do
  1109.     if g[l,0]<>0 then begin
  1110.       readin(g[l,0]+lp,userr);
  1111.       if userr.fm=-1 then g[l,1]:=userr.fl;
  1112.     end;
  1113.   for l:=1 to 9 do begin
  1114.     readin(l+lp,userr);
  1115.     userr.ft:=g[l,0];
  1116.     writeout(l+lp,userr);
  1117.   end;
  1118.   writeln;
  1119.   textcolor(7);
  1120.   writeln('Group Location Size Goal Type');
  1121.   textcolor(15);
  1122.   writeln('----- -------- ---- ---- ----');
  1123.   textcolor(2);
  1124.   for b:=1 to 9 do
  1125.     begin
  1126.       str(b,im);
  1127.       write(addblank(im,5));
  1128.       readin(lp+b,userr);
  1129.       r:=userr.ft;
  1130.       if r=0 then begin
  1131.         textcolor(9);
  1132.         writeln('   <Does not exist>');
  1133.       end else begin
  1134.         go:=userr.fq;
  1135.         readin(lp+r,userr);
  1136.         str(r,im);
  1137.         write(addblank(im,9));
  1138.         if userr.fm<>-1 then write(addblank('0',5))
  1139.         else begin;
  1140.           str(userr.fl,im);
  1141.           write(addblank(im,5));
  1142.         end;
  1143.         if go<>0 then begin
  1144.           str(go,im);
  1145.           write(addblank(im,5));
  1146.         end else write('     ');
  1147.         if b<3 then begin
  1148.           textcolor(3);
  1149.           writeln(' Defense');
  1150.           textcolor(2);
  1151.         end else
  1152.           if b<6 then begin
  1153.             textcolor(9);
  1154.             writeln(' Wandering');
  1155.             textcolor(2);
  1156.           end else
  1157.             if b<9 then begin
  1158.               textcolor(4);
  1159.               writeln(' Attack');
  1160.               textcolor(2);
  1161.             end else begin
  1162.               textcolor(4+16);
  1163.               writeln(' Attack top user');
  1164.               textcolor(2);
  1165.             end;
  1166.       end;
  1167.     end;
  1168.   end;
  1169.  
  1170. procedure edit_cabel;
  1171. var a,c:char;
  1172.     ts:str;
  1173.     y,t,num:integer;
  1174. begin
  1175.   writeln;
  1176.   write('Which group to edit (?=List):');
  1177.   read(a);
  1178.   writeln;
  1179.   case a of
  1180.   'Q',#13:done:=true;
  1181.   '?':cabel_writeln;
  1182.   '1'..'9':begin
  1183.              num:=value(a);
  1184.              readin(num+lp,userr);
  1185.              write('Which: (L)ocation, (S)ize, (G)oal, or (Q)uit: ');
  1186.              readch(ts);
  1187.              writeln;
  1188.              case ts[1] of
  1189.              'L':begin
  1190.                    t:=userr.ft;
  1191.                    write('New location: ');
  1192.                    getint(t);
  1193.                    if (t<1) or (t>ls-lp) then writeln ('Illegal sector')
  1194.                    else begin
  1195.                      readin(t+lp,usert);
  1196.                      if usert.fl<>0 then
  1197.                        if usert.fm=-1 then begin
  1198.                          writeln('A group of cabel already exists in that sector.');
  1199.                          write('(C)ombine groups or (A)bort: ');
  1200.                          read(c);
  1201.                          if c='A' then exit;
  1202.                        end else begin
  1203.                          readin(usert.fm,userr);
  1204.                          writeln('There are '+cstr(usert.fl)+
  1205.                                ' fighters belonging to '+userr.name+
  1206.                                ' in that sector.');
  1207.                          readin(num+lp,userr);
  1208.                          write('(D)elete player''s fighters or (A)bort: ');
  1209.                          read(c);
  1210.                          if c='A' then exit;
  1211.                          usert.fm:=0;
  1212.                          usert.fl:=0;
  1213.                        end;
  1214.                      writeout(t+lp,usert);
  1215.                      readin(userr.ft+lp,usert);
  1216.                      y:=usert.fl;
  1217.                      usert.fl:=0;
  1218.                      usert.fm:=0;
  1219.                      writeout(userr.ft+lp,usert);
  1220.                      readin(t+lp,usert);
  1221.                      usert.fl:=usert.fl+y;
  1222.                      usert.fm:=-1;
  1223.                      writeout(t+lp,usert);
  1224.                      userr.ft:=t;
  1225.                    end;
  1226.                  end;
  1227.              'S':begin
  1228.                    write('New Size: ');
  1229.                    t:=-1;
  1230.                    getint(t);
  1231.                    if t<>-1 then begin
  1232.                      readin(userr.ft+lp,usert);
  1233.                      usert.fl:=t;
  1234.                      writeout(userr.ft+lp,usert);
  1235.                    end;
  1236.                  end;
  1237.              'G':begin
  1238.                    readin(userr.ft+lp,usert);
  1239.                    if ((num>2) and (num<6) and ((usert.fl<50) or
  1240.                       (usert.fl>100))) or ((num>5) and ((usert.fl<20) or
  1241.                       (usert.fl>50)))
  1242.                    then begin
  1243.                      writeln('Note: The maintenance program will set the goal of this group to 83.');
  1244.                      writeln;
  1245.                    end;
  1246.                    write('New goal: ');
  1247.                    t:=-1;
  1248.                    getint(t);
  1249.                    if (t<1) or (t>ls-lp) then writeln('Illegal sector number.')
  1250.                    else userr.fq:=t;
  1251.                  end;
  1252.              end; {case}
  1253.              writeout(num+lp,userr);
  1254.            end;
  1255.   end; {case}
  1256. end;
  1257.  
  1258. begin
  1259.   done:=false;
  1260.   cabel_writeln;
  1261.   while not done do edit_cabel;
  1262. end;
  1263.  
  1264. procedure upplanet(s2:integer);
  1265. var l,c,mn : integer;
  1266.     dim       : real;
  1267. begin
  1268.   readin(s2,usert);
  1269.   n[1]:=usert.ff+usert.fi/10000;
  1270.   n[2]:=usert.fg+usert.fj/10000;
  1271.   n[3]:=usert.fh+usert.fk/10000;
  1272.   pub[1]:=usert.fc;
  1273.   pub[2]:=usert.fd;
  1274.   pub[3]:=usert.fe;
  1275.   getdate;
  1276.   c:=day;
  1277.   mn:=value(copy(time,1,2))*60+value(copy(time,4,2));
  1278.   dim:=day-usert.fb+(mn-usert.fr)/1440;
  1279.   if dim<0 then day:=0
  1280.   else
  1281.     if dim>10 then dim:=10.0;
  1282.   for l:=1 to 3 do begin
  1283.     n[l]:=n[l]+pub[l]*dim;
  1284.     if n[l]>pub[l]*10 then n[l]:=pub[l]*10;
  1285.   end;
  1286.   readin(s2,usert);
  1287.   usert.fb:=c;
  1288.   usert.ff:=trunc(n[1]);
  1289.   usert.fg:=trunc(n[2]);
  1290.   usert.fh:=trunc(n[3]);
  1291.   for l:=1 to 3 do begin
  1292.     srr[l,0]:=int((n[l]-int(n[l]))*10000+0.5);
  1293.     n[l]:=int(n[l]);
  1294.   end;
  1295.   usert.fi:=trunc(srr[1,0]);
  1296.   usert.fj:=trunc(srr[2,0]);
  1297.   usert.fk:=trunc(srr[3,0]);
  1298.   usert.fr:=mn;
  1299.   writeout(s2,usert);
  1300. end;
  1301.  
  1302. procedure planet;
  1303. var i,t,y,planetnum:integer;
  1304.     st:str;
  1305.     c:str;
  1306. begin
  1307.   done:=false;
  1308.   writeln('Edit which planet: "###" (sector number) or "P###" (planet number)');
  1309.   write('Planet ID: (<CR>=Abort): ');
  1310.   readch(st);
  1311.   writeln;
  1312.   if st='' then exit;
  1313.   if st[1]='P' then planetnum:=value(copy(st,2,3))
  1314.   else begin
  1315.     i:=value(st);
  1316.     if (i<1) or (i>ls-lp) then begin
  1317.       writeln('Illegal sector number.');
  1318.       exit;
  1319.     end;
  1320.     readin(i+lp,usert);
  1321.     planetnum:=usert.fo;
  1322.     if planetnum=0 then begin
  1323.       writeln('No planet in that sector.');
  1324.       exit;
  1325.     end;
  1326.   end;
  1327.   if (planetnum<1) or (planetnum>ll1-lt1) then begin
  1328.     writeln('Illegal planet number');
  1329.     exit;
  1330.   end;
  1331.   planetnum:=planetnum+lt1;
  1332.   upplanet(planetnum);
  1333.   repeat
  1334.     writeln('Planet number: '+cstr(planetnum-lt1));
  1335.     writeln('<A> Name: '+usert.name);
  1336.     writeln('<M> Made by: '+usert.realname);
  1337.     writeln('<B> Ore: '+cstr(usert.ff));
  1338.     writeln('<C> Organics: '+cstr(usert.fg));
  1339.     writeln('<D> Equipment: '+cstr(usert.fh));
  1340.     writeln('Productivity (units per day):');
  1341.     writeln('   <E> Ore: '+cstr(usert.fc)+'   <F> Org: '+cstr(usert.fd)+
  1342.           '   <G> Equ: '+cstr(usert.fe));
  1343.     writeln('<!> Delete/Create this planet');
  1344.     writeln;
  1345.     write('Planet Editor: (Q=Quit): ');
  1346.     readch(c);
  1347.     writeln;
  1348.     case c of
  1349.     'Q',#13:done:=true;
  1350.     'A':begin
  1351.           write('New planet name: ');
  1352.           readln(st);
  1353.           if st<>'' then usert.name:=st;
  1354.         end;
  1355.     'M':begin
  1356.           write('New Creator name: ');
  1357.           readln(st);
  1358.           if st<>'' then usert.realname:=st;
  1359.         end;
  1360.     'B':begin
  1361.           write('New amount of ore: ');
  1362.           getint(usert.ff);
  1363.           if usert.ff>usert.fc*10.0 then
  1364.             writeln('WARNING: Normal range is 0 to '+cstr(usert.fh*10)+'.');
  1365.         end;
  1366.     'C':begin
  1367.           write('New amount of organics: ');
  1368.           getint(usert.fg);
  1369.           if usert.fg>usert.fd*10.0 then
  1370.             writeln('WARNING: Normal range is 0 to '+cstr(usert.fh*10)+'.');
  1371.         end;
  1372.     'D':begin
  1373.           write('New amount of equipment: ');
  1374.           getint(usert.fh);
  1375.           if usert.fh>usert.fe*10.0 then
  1376.             writeln('WARNING: Normal range is 0 to '+cstr(usert.fh*10)+'.');
  1377.         end;
  1378.     'E':begin
  1379.           write('Productivity (units/day) for ore: ');
  1380.           getint(usert.fc);
  1381.           if usert.fc>3000 then writeln('WARNING: Safe range in 0 to 3000.');
  1382.         end;
  1383.     'F':begin
  1384.           write('Productivity (units/day) for organics: ');
  1385.           getint(usert.fd);
  1386.           if usert.fd>3000 then writeln('WARNING: Safe range in 0 to 3000.');
  1387.         end;
  1388.     'G':begin
  1389.           write('Productivity (units/day) for equipment: ');
  1390.           getint(usert.fe);
  1391.           if usert.fe>3000 then writeln('WARNING: Safe range in 0 to 3000.');
  1392.         end;
  1393.     '!':if usert.fm<>0 then begin
  1394.           ynq('Delete planet '+usert.name+' (Y/N) ? ');
  1395.           if yn then begin
  1396.             for t:=lp+1 to ls do begin
  1397.               readin(t,userr);
  1398.               if userr.fo=planetnum-lt1 then begin
  1399.                 userr.fo:=0;
  1400.                 writeout(t,userr);
  1401.               end;
  1402.             end;
  1403.             usert.fm:=0;
  1404.             writeln;
  1405.             writeln('Planet deleted.');
  1406.           end;
  1407.         end else begin
  1408.           writeln('Creating planet:');
  1409.           writeln;
  1410.           write('New planet name: ');
  1411.           readln(st);
  1412.           if st<>'' then begin
  1413.             writeln;
  1414.             write('What sector is this planet to be located in: ');
  1415.             y:=-1;
  1416.             getint(y);
  1417.             if (y<0) or (y>ls-lp) then writeln('Illegal sector number.')
  1418.             else begin
  1419.               readin(y+lp,userr);
  1420.               if userr.fo<>0 then writeln('There is already a planet in that sector!')
  1421.               else begin
  1422.                 userr.fo:=planetnum-lt1;
  1423.                 writeout(y+lp,userr);
  1424.                 usert.name:=st;
  1425.                 write('Who gets credit for its creation?: ');
  1426.                 readln(st);
  1427.                 usert.realname:=st;
  1428.                 usert.fm:=2;
  1429.               end;
  1430.             end;
  1431.           end;
  1432.         end;
  1433.     end; {case}
  1434.     writeout(planetnum,usert);
  1435.   until done;
  1436. end;
  1437.  
  1438. procedure mainmenu;
  1439. var i: str;
  1440.     int:integer;
  1441.  
  1442. procedure helpit;
  1443. var a,n:boolean;
  1444. begin
  1445.   writeln('<Help>');
  1446.   writeln; a:=false;
  1447.   writeln('C - Cabel editor');
  1448.   writeln('G - edit General information');
  1449.   writeln('L - List current users');
  1450.   writeln('N - plaNet editor');
  1451.   writeln('P - Port editor');
  1452.   writeln('Q - Quit editor and exit to main system');
  1453.   writeln('S - Sector editor');
  1454.   writeln('U - User editor');
  1455. end;
  1456.  
  1457. begin
  1458.   writeln;
  1459.   write('Trade Wars Editor (?=Help): ');
  1460.   readch(i);
  1461.   writeln;
  1462.   done:=false;
  1463.   case i[1] of
  1464.   'C':cabel;
  1465.   'G':repeat gedit until done;
  1466.   'L':userlist;
  1467.   'N':planet;
  1468.   'P':port;
  1469.   'Q':ended:=true;
  1470.   'S':sector;
  1471.   'U':repeat uedit until done;
  1472.   '?':helpit;
  1473.   end; {case}
  1474. end;
  1475.  
  1476. begin
  1477.   ended:=false;
  1478.   init;
  1479.   while (not ended) do mainmenu;
  1480.   close(userf);
  1481.   close(msger);
  1482.   close(smallmsg);
  1483. end.
  1484.